home *** CD-ROM | disk | FTP | other *** search
/ Atari Forever 4 / Atari Forever 4.zip / Atari Forever 4.iso / SERIE_S / S_904 / HALMA / HALMA.GFA (.txt) next >
GFA-BASIC Atari  |  1998-03-14  |  22KB  |  868 lines
  1. ' Globale Fenstervariablen: hand,wx,wy,ww,wh,s_v
  2. $m30000
  3. a&=APPL_INIT()
  4. ' ON ERROR GOSUB err
  5. window_install
  6. '
  7. '
  8. DIM feld.spieler|(18,18) ! Welchem Spieler gehört der Stein ?
  9. DIM feld.stein|(18,18)   !Steinnr., für jeden Spieler von 0 bis 14
  10. ARRAYFILL feld.stein|(),255
  11. DIM feld!(20,20)        ! Welche Punkte im 18*18 Feld gehören zum Spielfeld
  12. spieler_anz|=2          ! Anzahl der Spieler (anderes geht auch nicht)
  13. DIM figur.x|(spieler_anz|,15),figur.y|(spieler_anz|,15)
  14. '
  15. zug.maxanz|=200
  16. max_tiefe|=7
  17. ' denktiefe|
  18. DIM zug.x|(max_tiefe|,zug.maxanz|)       !x-Zielfeld der mögl. Züge
  19. DIM zug.y|(max_tiefe|,zug.maxanz|)       !y-Zielfeld
  20. DIM zug.stein|(max_tiefe|,zug.maxanz|)   !steinnr mit dem auf x-,y-Zielfeld gezogen werden kann
  21. '
  22. DIM wert&(max_tiefe|,zug.maxanz|)
  23. DIM wert.p&(max_tiefe|,zug.maxanz|)
  24. DIM weiter_testen&(max_tiefe|)
  25. '
  26. DIM compi!(spieler_anz|)
  27. '
  28. '
  29. dh|=21          !Abstände zw. Feldpunkten
  30. dw|=24
  31. bewerte.init
  32. '
  33. '
  34. IF a&=0
  35.   prg!=TRUE
  36.   hand&=@openw
  37. ELSE
  38.   menu&=MENU_REGISTER(a&,"  Halma")
  39.   WHILE menu&=-1  !zuviele einträge
  40.     ~EVNT_MESAG(0)
  41.   WEND
  42. ENDIF
  43. '
  44. ~EVNT_MESAG(0)  !Redraw,clipping
  45. fenster
  46. '
  47. DO
  48.   IF hand&<>-1
  49.     haupt
  50.   ELSE
  51.     ~EVNT_MESAG(0)
  52.     fenster
  53.   ENDIF
  54. LOOP
  55. '
  56. > PROCEDURE haupt
  57.   REPEAT
  58.     ARRAYFILL feld!(),FALSE
  59.     eingabe             !Wer gegen wen, denktiefe| einstellen
  60.     '
  61.     zugnr%=0              !für die Eröffnung
  62.     mache_feld
  63.     figuren_aufbau(spieler_anz|)
  64.     zeige_feld
  65.     '
  66.     '
  67.     game
  68.     print("Nochmal (j/n)")
  69.   UNTIL UPPER$(CHR$(INP(2)))<>"J"
  70. RETURN
  71. '
  72. > PROCEDURE eingabe
  73.   LOCAL w|,a|
  74.   @print(" 0. Mensch - Mensch")
  75.   @print(" 1. Mensch - Computer")
  76.   @print(" 2. Computer - Mensch")
  77.   @print(" 3. Computer - Computer")
  78.   REPEAT
  79.     a|=ASC(@input$(" Wahl:",1))
  80.   UNTIL VAL?(CHR$(a|))
  81.   w|=VAL(CHR$(a|))
  82.   compi!(1)=w| AND 2
  83.   compi!(2)=w| AND 1
  84.   '
  85.   IF w|
  86.     print("")
  87.     print(" Computereinstellung")
  88.     print(" 1. Schwach")
  89.     print(" 2. Normal")
  90.     REPEAT
  91.       a|=ASC(@input$(" Wahl:",1))
  92.     UNTIL VAL?(CHR$(a|))
  93.     denktiefe|=VAL(CHR$(a|))-1
  94.   ENDIF
  95.   @cls
  96. RETURN
  97. ' ---- Feldvariablen initialisieren ----
  98. > PROCEDURE mache_feld
  99.   ' Die Punkte in feld!(), die zum Spielfeld gehören, werden TRUE gesetzt
  100.   LOCAL i|,j|
  101.   ARRAYFILL feld!(),FALSE
  102.   FOR i|=0 TO 12
  103.     FOR j|=i| TO 12
  104.       feld!(i|+4+2,j|+2)=TRUE
  105.     NEXT j|
  106.   NEXT i|
  107.   FOR i|=0 TO 12
  108.     FOR j|=12-i| TO 12
  109.       feld!(i|+2,12-j|+4+2)=TRUE
  110.     NEXT j|
  111.   NEXT i|
  112. RETURN
  113. > PROCEDURE figuren_aufbau(spieler_anz|)
  114.   ' Die Steine der Spieler werden auf das Feld gesetzt
  115.   LOCAL i|,j|,nr&
  116.   ARRAYFILL feld.spieler|(),0
  117.   ARRAYFILL feld.stein|(),255
  118.   ARRAYFILL figur.x|(),0
  119.   ARRAYFILL figur.y|(),0
  120.   FOR j|=0 TO 4
  121.     FOR i|=j| TO 4
  122.       feld.spieler|(8-i|,4-j|)=1
  123.       feld.stein|(8-i|,4-j|)=nr&
  124.       figur.x|(1,nr&)=8-i|
  125.       figur.y|(1,nr&)=4-j|
  126.       '
  127.       ' if spieler_anz|=3 ...
  128.       feld.spieler|(8+i|,12+j|)=2
  129.       feld.stein|(8+i|,12+j|)=nr&
  130.       figur.x|(2,nr&)=8+i|
  131.       figur.y|(2,nr&)=12+j|
  132.       '
  133.       INC nr&
  134.     NEXT i|
  135.   NEXT j|
  136. RETURN
  137. '
  138. ' ---- Der Spielablauf und die Gewonnen-Kontrolle ------
  139. > PROCEDURE game
  140.   LOCAL sieger|
  141.   REPEAT
  142.     FOR spieler|=1 TO spieler_anz|
  143.       IF compi!(spieler|)
  144.         ~@denken(0,spieler|)
  145.       ELSE
  146.         spieler(spieler|)
  147.       ENDIF
  148.       sieger|=@gewonnen
  149.       EXIT IF INKEY$="E" OR sieger|
  150.     NEXT spieler|
  151.     EXIT IF INKEY$="E"
  152.   UNTIL sieger|
  153.   IF compi!(sieger|)
  154.     @print("Computer "+STR$(sieger|)+" hat gewonnen.")
  155.   ELSE
  156.     @print("Spieler "+STR$(sieger|)+" hat gewonnen.")
  157.   ENDIF
  158. RETURN
  159. > PROCEDURE ziehe(spieler|,von.x|,von.y|,nach.x|,nach.y|,zug!)
  160.   feld.spieler|(von.x|,von.y|)=0
  161.   feld.spieler|(nach.x|,nach.y|)=spieler|
  162.   figur.x|(spieler|,feld.stein|(von.x|,von.y|))=nach.x|
  163.   '
  164.   figur.y|(spieler|,feld.stein|(von.x|,von.y|))=nach.y|
  165.   '
  166.   feld.stein|(nach.x|,nach.y|)=feld.stein|(von.x|,von.y|)
  167.   '
  168.   feld.stein|(von.x|,von.y|)=255
  169.   '
  170.   IF zug!
  171.     zeichne_punkt(von.x|,von.y|,FALSE)
  172.     zeichne_punkt(nach.x|,nach.y|,FALSE)
  173.   ENDIF
  174. RETURN
  175. > FUNCTION gewonnen
  176.   LOCAL gewonnen.1!,gewonnen.2!,i|,j|
  177.   gewonnen.1!=TRUE
  178.   gewonnen.2!=TRUE
  179.   FOR j|=0 TO 4
  180.     FOR i|=j| TO 4
  181.       gewonnen.1!=gewonnen.1! AND feld.spieler|(8+i|,j|+12)=1
  182.       gewonnen.2!=gewonnen.2! AND feld.spieler|(8-i|,4-j|)=2
  183.     NEXT i|
  184.   NEXT j|
  185.   IF gewonnen.1!
  186.     RETURN 1
  187.   ELSE IF gewonnen.2!
  188.     RETURN 2
  189.   ENDIF
  190.   RETURN 0
  191. ENDFUNC
  192. '
  193. ' ---- Die Züge von einem Spieler -----
  194. > PROCEDURE spieler(spieler|)
  195.   LOCAL moegl!,nr&,von.x|,von.y|,nach.x|,nach.y|
  196.   nr&=@suche_zuege(spieler|,0)
  197.   REPEAT
  198.     text&=0
  199.     @print(" Spieler "+STR$(spieler|)+" ist dran!")
  200.     moegl!=@zugeingabe(spieler|,nr&,von.x|,von.y|,nach.x|,nach.y|)
  201.     IF moegl!=0
  202.       OUT 2,7
  203.       text&=1
  204.       @print("Zug nicht möglich!")
  205.       ~EVNT_TIMER(1500) ! 1.5s
  206.       text&=1
  207.       @print("                  ")
  208.     ENDIF
  209.   UNTIL moegl!
  210.   text&=1
  211.   @print("     ")
  212.   ziehe(spieler|,von.x|,von.y|,nach.x|,nach.y|,1)
  213. RETURN
  214. > FUNCTION zugeingabe(spieler|,nr&,VAR von.x|,von.y|,nach.x|,nach.y|)
  215.   LOCAL mx&,my&,i&,maus|
  216.   ' ---- Die Eingabe der von Start- und Zielpunkt ----
  217.   REPEAT
  218.     text&=1
  219.     @print(" von ")
  220.     REPEAT
  221.       maus|=@punkt(von.x|,von.y|)
  222.     UNTIL feld.spieler|(von.x|,von.y|)=spieler|
  223.     '
  224.     text&=1
  225.     @print(" nach")
  226.     maus|=@punkt(nach.x|,nach.y|)
  227.   UNTIL maus|=1
  228.   '
  229.   ' ---- Kontrolle, ob der Zug erlaubt ist ----
  230.   i&=0
  231.   REPEAT
  232.     ' steinkontrolle, wird der Richtige stein gezogen?
  233.     IF feld.stein|(von.x|,von.y|)=zug.stein|(0,i&)
  234.       IF zug.x|(0,i&)=nach.x| AND zug.y|(0,i&)=nach.y|
  235.         ' PRINT "ok "
  236.         RETURN TRUE
  237.       ENDIF
  238.     ENDIF
  239.     INC i&
  240.   UNTIL i&=nr&
  241.   '  PRINT "nok "
  242.   RETURN FALSE
  243. ENDFUNC
  244. > FUNCTION punkt(VAR x|,y|)              !Eingabe von einem Feldpunkt
  245.   LOCAL x&,y&,mt&
  246.   LOCAL wx1&,wy1&,ww1&,wh1&
  247.   ~WIND_GET(hand&,4,wx1&,wy1&,ww1&,wh1&)
  248.   '
  249.   mt&=@maus(x&,y&)
  250.   '
  251.   y|=MAX(-INT(y&-(wy1&+wh1&-8)-dh|/2)/dh|,0)
  252.   x|=MAX(INT((x&-(wx1&+ww1&/2))/dw|+(y|-7.5)/2+8),0) !7.5+0.5
  253.   '
  254.   RETURN mt&
  255. ENDFUNC
  256. '
  257. ' ---- Anzeigeroutinen -------------
  258. > PROCEDURE zeige_feld
  259.   LOCAL i|,j|
  260.   LOCAL cx&,cy&
  261.   LOCAL wx1&,wy1&,ww1&,wh1&
  262.   '
  263.   IF feld!(10,10)               !Aufbauen
  264.     ~WIND_GET(hand&,4,wx1&,wy1&,ww1&,wh1&)
  265.     cx&=wx1&+ww1&/2
  266.     cy&=wy1&+wh1&-8
  267.     FOR i|=0 TO 12
  268.       LINE cx&-(i|-0.5)/2*dw|,cy&-16*dh|+i|*dh|,cx&+(i|+0.5)/2*dw|,cy&-16*dh|+i|*dh|
  269.       LINE cx&-(i|-0.5)/2*dw|,cy&-i|*dh|,cx&+(i|+0.5)/2*dw|,cy&-i|*dh|
  270.       LINE cx&+(i|-6)*dw|+dw|/4,cy&-12*dh|,cx&+i|/2*dw|+dw|/4,cy&-i|*dh|
  271.       LINE cx&+(i|-6)*dw|+dw|/4,cy&-12*dh|,cx&+i|/2*dw|+dw|/4,cy&-i|*dh|
  272.       LINE cx&-(i|-0.5)/2*dw|,cy&-16*dh|+i|*dh|,cx&-(i|-6.25)*dw|,cy&-4*dh|
  273.       LINE cx&+(i|-5.75)*dw|,cy&-4*dh|,cx&+(i|+0.5)/2*dw|,cy&-16*dh|+i|*dh|
  274.       LINE cx&-(i|-0.5)/2*dw|,cy&-i|*dh|,cx&-(i|-6.25)*dw|,cy&-12*dh|
  275.     NEXT i|
  276.   ENDIF
  277.   '
  278.   FOR j|=0 TO 16
  279.     FOR i|=0 TO 16
  280.       IF feld!(i|+2,j|+2)
  281.         zeichne_punkt(i|,j|,TRUE)
  282.       ENDIF
  283.     NEXT i|
  284.   NEXT j|
  285. RETURN
  286. > PROCEDURE zeichne_punkt(i|,j|,f!)
  287.   LOCAL wx1&,wy1&,ww1&,wh1&
  288.   ~WIND_GET(hand&,4,wx1&,wy1&,ww1&,wh1&)
  289.   DEFFILL 1,0,0
  290.   IF f!=0
  291.     DEFFILL 1,0,0
  292.     PCIRCLE wx1&+ww1&/2+((i|-7.5)-(j|-7.5)/2)*dw|,wy1&+wh1&-8-j|*dh|,7
  293.     ~EVNT_TIMER(150)
  294.     DEFFILL 1,1,1
  295.     PCIRCLE wx1&+ww1&/2+((i|-7.5)-(j|-7.5)/2)*dw|,wy1&+wh1&-8-j|*dh|,7
  296.     ~EVNT_TIMER(150)
  297.   ENDIF
  298.   SELECT feld.spieler|(i|,j|)
  299.   CASE 1
  300.     DEFFILL 1,2,5
  301.   CASE 2
  302.     DEFFILL 1,2,8
  303.   DEFAULT
  304.     DEFFILL 1,0,0
  305.   ENDSELECT
  306.   PCIRCLE wx1&+ww1&/2+((i|-7.5)-(j|-7.5)/2)*dw|,wy1&+wh1&-8-j|*dh|,7
  307. RETURN
  308. > PROCEDURE line(x&,y&,x1&,y1&)
  309.   LOCAL wx1&,wy1&,ww1&,wh1&
  310.   '
  311.   IF x1&=>0 AND y1&=>0 AND x1&<17 AND y1&<17
  312.     IF feld!(x1&+2,y1&+2)
  313.       ~WIND_GET(hand&,4,wx1&,wy1&,ww1&,wh1&)
  314.       DRAW wx1&+ww1&/2+((x&-7.5)-(y&-7.5)/2)*dw|,wy1&+wh1&-8-y&*dh|
  315.       DRAW  TO wx1&+ww1&/2+((x1&-7.5)-(y1&-7.5)/2)*dw|,wy1&+wh1&-8-y1&*dh|
  316.     ENDIF
  317.   ENDIF
  318. RETURN
  319. '
  320. ' ---- mögliche Züge von spieler| suchen -----
  321. > FUNCTION suche_zuege(spieler|,tiefe|)
  322.   ' Rückgabe: Anz. der mögl. Züge
  323.   ' in zug.x(spieler,i) und zug.y(spieler,i) werden die Zielfelder der Züge
  324.   ' hineingeschrieben. zug.stein(spieler.i) enthält den Wert des Steines, der
  325.   ' zieht.
  326.   LOCAL i|,x|,y|,nr&
  327.   '
  328.   FOR i|=0 TO 14
  329.     x|=figur.x|(spieler|,i|)
  330.     y|=figur.y|(spieler|,i|)
  331.     zuege_vom_stein(x|,y|,tiefe|,feld.stein|(x|,y|),FALSE,nr&)
  332.   NEXT i|
  333.   RETURN nr&
  334. ENDFUNC
  335. > PROCEDURE zuege_vom_stein(i|,j|,tiefe|,stein|,jumped!,VAR nr&)
  336.   ' die Prozedur testet in jede Richtung, ob der Stein i j gezogen werden kann
  337.   ' +. .+ ++ -. .- --
  338.   zug(i|,j|,tiefe|,stein|,jumped!,1,0,nr&)
  339.   zug(i|,j|,tiefe|,stein|,jumped!,0,1,nr&)
  340.   zug(i|,j|,tiefe|,stein|,jumped!,1,1,nr&)
  341.   zug(i|,j|,tiefe|,stein|,jumped!,-1,0,nr&)
  342.   zug(i|,j|,tiefe|,stein|,jumped!,0,-1,nr&)
  343.   zug(i|,j|,tiefe|,stein|,jumped!,-1,-1,nr&)
  344. RETURN
  345. > PROCEDURE zug(i&,j&,tiefe|,stein|,jumped!,iadd&,jadd&,VAR nr&)
  346.   '
  347.   ' Wenn der Zug in iadd,jadd-Richtung auf dem Spielfeld landet
  348.   '   Wenn das Feld auf der Postion frei ist
  349.   '     Wenn der Stein noch nicht gesprungen ist
  350.   '       Dieser Zug ist möglich
  351.   '   sonst wenn ein Sprung in die Richtung noch im Feld liegt
  352.   '       wenn das Feld, auf das der Sprung zielt, frei ist
  353.   '         wenn der Stein noch nicht auf dieses Feld gesprungen ist
  354.   '           Dieser Zug ist möglich
  355.   '           es kann nur noch gesprungen werden (jumped=TRUE)
  356.   '           kann der Stein nochmal springen? ->rekursiv
  357.   ADD i&,iadd&
  358.   ADD j&,jadd&
  359.   IF feld!(i&+2,j&+2)
  360.     IF feld.spieler|(i&,j&)=0
  361.       IF jumped!=FALSE
  362.         zug.x|(tiefe|,nr&)=i&
  363.         zug.y|(tiefe|,nr&)=j&
  364.         zug.stein|(tiefe|,nr&)=stein|
  365.         INC nr&
  366.       ENDIF
  367.     ELSE
  368.       ADD i&,iadd&
  369.       ADD j&,jadd&
  370.       IF feld!(i&+2,j&+2)
  371.         IF feld.spieler|(i&,j&)=0
  372.           IF @schon(i&,j&,tiefe|,stein|,nr&)=FALSE
  373.             zug.x|(tiefe|,nr&)=i&
  374.             zug.y|(tiefe|,nr&)=j&
  375.             zug.stein|(tiefe|,nr&)=stein|
  376.             INC nr&
  377.             zuege_vom_stein(i&,j&,tiefe|,stein|,TRUE,nr&)
  378.           ENDIF
  379.         ENDIF
  380.       ENDIF
  381.     ENDIF
  382.   ENDIF
  383. RETURN
  384. > FUNCTION schon(i|,j|,tiefe|,stein|,nr&)
  385.   ' gibt TRUE zurück, wenn stein| schon einmal auf i|,j| gestanden hat.
  386.   ' die Funktion geht davon aus, daß alle mögl. Züge des Steins hinterein-
  387.   ' ander stehen
  388.   LOCAL k&
  389.   k&=nr&
  390.   WHILE k&
  391.     DEC k&
  392.     IF zug.stein|(tiefe|,k&)=stein|
  393.       IF zug.x|(tiefe|,k&)=i|
  394.         IF zug.y|(tiefe|,k&)=j|
  395.           RETURN TRUE
  396.         ENDIF
  397.       ENDIF
  398.     ELSE
  399.       k&=0
  400.     ENDIF
  401.   WEND
  402.   RETURN FALSE
  403. ENDFUNC
  404. '
  405. > FUNCTION denken(tiefe|,spieler|)
  406.   LOCAL i&,p.i&,max|
  407.   text&=0
  408.   @print(" Compi überlegt.    ")
  409.   '
  410.   INC zugnr%
  411.   '  IF zugnr%>3
  412.   weiter_testen&(0)=6
  413.   weiter_testen&(1)=22
  414.   weiter_testen&(2)=3
  415.   weiter_testen&(3)=5
  416.   max_tiefe|=denktiefe|
  417.   ~@denk_mal(0,spieler|)
  418.   qsort(0,weiter_testen&(0)-1,0,wert&(),wert.p&())
  419.   '
  420.   '
  421.   IF zugnr%>4
  422.     i&=0                  !wählt zufällig einen gleichguten zug aus
  423.     REPEAT
  424.       INC i&
  425.     UNTIL wert&(0,i&)<>wert&(0,i&-1) OR i&>=weiter_testen&(0)
  426.     p.i&=wert.p&(0,RANDOM(i&))
  427.   ELSE
  428.     IF spieler|=1
  429.       max|=0
  430.       FOR i&=0 TO 5
  431.         max|=MAX(max|,zug.y|(0,wert.p&(0,i&)))
  432.       NEXT i&
  433.       p.i&=-1
  434.       FOR i&=5 DOWNTO 0
  435.         IF max|=zug.y|(0,wert.p&(0,i&)) AND (p.i&=-1 OR RANDOM(2)=0)
  436.           p.i&=wert.p&(0,i&)
  437.         ENDIF
  438.       NEXT i&
  439.     ELSE
  440.       max|=16
  441.       FOR i&=0 TO 5
  442.         max|=MIN(max|,zug.y|(0,wert.p&(0,i&)))
  443.       NEXT i&
  444.       p.i&=-1
  445.       FOR i&=5 DOWNTO 0
  446.         IF max|=zug.y|(0,wert.p&(0,i&)) AND (p.i&=-1 OR RANDOM(2)=0)
  447.           p.i&=wert.p&(0,i&)
  448.         ENDIF
  449.       NEXT i&
  450.     ENDIF
  451.   ENDIF
  452.   '
  453.   ziehe(spieler|,figur.x|(spieler|,zug.stein|(0,p.i&)),figur.y|(spieler|,zug.stein|(0,p.i&)),zug.x|(0,p.i&),zug.y|(0,p.i&),1)
  454.   ' ELSE
  455.   '  ~@eroeffnung(spieler|,zugnr%)
  456.   ' ENDIF
  457.   RETURN 0
  458. ENDFUNC
  459. > FUNCTION bewerte(tiefe|,spieler|)
  460.   LOCAL i&,nr&,wert.alt&,zugstein|,zugstein.alt|
  461.   ' bewertet alle Züge, die spieler jetzt machen kann und sortiert sie
  462.   ' Rückgabewert ist die Zahl der mögl. Züge
  463.   '
  464.   zugstein.alt|=16      !nicht vorhandener Wert
  465.   control
  466.   nr&=@suche_zuege(spieler|,tiefe|)
  467.   control
  468.   FOR i&=0 TO nr&-1
  469.     wert.p&(tiefe|,i&)=i&
  470.     zugstein|=zug.stein|(tiefe|,i&)
  471.     IF zugstein|<>zugstein.alt|
  472.       wert.alt&=@wert(spieler|,figur.x|(spieler|,zugstein|),figur.y|(spieler|,zugstein|))
  473.       zugstein.alt|=zugstein|
  474.     ENDIF
  475.     wert&(tiefe|,i&)=@wert(spieler|,zug.x|(tiefe|,i&),zug.y|(tiefe|,i&))-wert.alt&
  476.   NEXT i&
  477.   qsort(0,nr&-1,tiefe|,wert&(),wert.p&())
  478.   RETURN nr&
  479. ENDFUNC
  480. > FUNCTION denk_mal(tiefe|,spieler|)
  481.   LOCAL nr&,i&,j&,best&,best_tiefer&,fx|,fy|,p.i&
  482.   '
  483.   ' ----- Bewertung der Züge noch onhe Gegenzug -----
  484.   nr&=@bewerte(tiefe|,spieler|)
  485.   '
  486.   ' --- die bisher besten weiter_testen&() Züge ausführen ---
  487.   IF ODD(tiefe|)
  488.     best&=32767
  489.   ELSE
  490.     best&=-32768
  491.   ENDIF
  492.   IF tiefe|<max_tiefe|
  493.     i&=0
  494.     WHILE wert&(tiefe|,i&)>0
  495.       p.i&=wert.p&(tiefe|,i&)
  496.       fx|=figur.x|(spieler|,zug.stein|(tiefe|,p.i&))
  497.       fy|=figur.y|(spieler|,zug.stein|(tiefe|,p.i&))
  498.       ziehe(spieler|,fx|,fy|,zug.x|(tiefe|,p.i&),zug.y|(tiefe|,p.i&),0)
  499.       '
  500.       ' --- Die beste Hälfte der Gegenzüge ausführen ---
  501.       best_tiefer&=@denk_mal(tiefe|+1,(spieler| MOD 2)+1)
  502.       '
  503.       ADD wert&(tiefe|,i&),best_tiefer&
  504.       IF ODD(tiefe|)
  505.         IF best&>wert&(tiefe|,i&)
  506.           best&=wert&(tiefe|,i&)
  507.         ENDIF
  508.       ELSE
  509.         IF best&<wert&(tiefe|,i&)
  510.           best&=wert&(tiefe|,i&)
  511.         ENDIF
  512.       ENDIF
  513.       ziehe(spieler|,zug.x|(tiefe|,p.i&),zug.y|(tiefe|,p.i&),fx|,fy|,0)
  514.       INC i&
  515.     WEND
  516.     weiter_testen&(tiefe|)=i&
  517.   ELSE !IF tiefe|=max_tiefe|
  518.     best&=-32768
  519.     i&=0
  520.     WHILE wert&(tiefe|,i&)>=0 !weiter_testen&(tiefe|)
  521.       IF best&<wert&(tiefe|,i&)
  522.         best&=wert&(tiefe|,i&)
  523.       ENDIF
  524.       INC i&
  525.     WEND
  526.     IF ODD(tiefe|)
  527.       MUL best&,-1
  528.     ENDIF
  529.   ENDIF
  530.   RETURN best&
  531.   '
  532.   '  PRINT "==>";(TIMER-t%)/200/nr&;"s"
  533. ENDFUNC
  534. > FUNCTION wert(spieler|,x|,y|)
  535.   ' hohe werte - gute züge
  536.   IF spieler|=1
  537.     RETURN wert|(x|,y|)
  538.   ELSE IF spieler|=2
  539.     RETURN wert|(16-x|,16-y|)
  540.   ENDIF
  541. ENDFUNC
  542. > PROCEDURE control
  543.   LOCAL rueck&,d&,taste&
  544.   rueck&=EVNT_MULTI(&X110001,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,d&,d&,d&,d&,taste&,d&)
  545.   '                     f   c m s 1 2 3 4 5 1 2 3 4 5 a c mx my mt ks
  546.   IF rueck& AND &X10000
  547.     fenster
  548.   ENDIF
  549.   IF rueck& AND 1
  550.     IF taste&=27
  551.       @closew(hand&)
  552.     ENDIF
  553.   ENDIF
  554. RETURN
  555. '
  556. > PROCEDURE qsort(l&,r&,tiefe&,VAR feld&(),feldmitsort&())
  557.   LOCAL i&,j&,a&
  558.   i&=l&
  559.   j&=r&
  560.   a&=feld&(tiefe&,INT((i&+j&)/2))
  561.   REPEAT
  562.     WHILE feld&(tiefe&,i&)>a&
  563.       INC i&
  564.     WEND
  565.     WHILE a&>feld&(tiefe&,j&)
  566.       DEC j&
  567.     WEND
  568.     IF i&<=j&
  569.       SWAP feld&(tiefe&,i&),feld&(tiefe&,j&)
  570.       SWAP feldmitsort&(tiefe&,i&),feldmitsort&(tiefe&,j&)
  571.       INC i&
  572.       DEC j&
  573.     ENDIF
  574.   UNTIL i&>j&
  575.   IF l&<j&
  576.     @qsort(l&,j&,tiefe&,feld&(),feldmitsort&())
  577.   ENDIF
  578.   IF i&<r&
  579.     @qsort(i&,r&,tiefe&,feld&(),feldmitsort&())
  580.   ENDIF
  581. RETURN
  582. '
  583. > PROCEDURE bewerte.init
  584.   DIM wert|(16,16)
  585.   LOCAL x|,y|,data|,k|
  586.   FOR k|=0 TO 2
  587.     FOR y|=0 TO 16
  588.       FOR x|=0 TO 16
  589.         READ data|
  590.         ADD wert|(x|,16-y|),data|
  591.         '      PRINT AT(x|*3+1,y|+2);wert|(x|,16-y|)'
  592.       NEXT x|
  593.       '    PRINT
  594.     NEXT y|
  595.   NEXT k|
  596.   '
  597.   ' Bewertung durch Entfernung vom Ziel
  598.   DATA    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,160,  0,  0,  0,  0
  599.   DATA    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,160,160,  0,  0,  0,  0
  600.   DATA    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,150,150,150,  0,  0,  0,  0
  601.   DATA    0,  0,  0,  0,  0,  0,  0,  0,  0,140,140,140,140,  0,  0,  0,  0
  602.   DATA    0,  0,  0,  0, 90,100,110,120,130,130,130,130,130,120,110,100, 90
  603.   DATA    0,  0,  0,  0, 90,100,110,120,120,120,120,120,120,110,100, 90,  0
  604.   DATA    0,  0,  0,  0, 90,100,110,110,110,110,110,110,110,100, 90,  0,  0
  605.   DATA    0,  0,  0,  0, 90,100,100,100,100,100,100,100,100, 90,  0,  0,  0
  606.   DATA    0,  0,  0,  0, 90, 90, 90, 90, 90, 90, 90, 90, 90,  0,  0,  0,  0
  607.   DATA    0,  0,  0, 80, 80, 80, 80, 80, 80, 80, 80, 80, 80,  0,  0,  0,  0
  608.   DATA    0,  0, 70, 70, 70, 70, 70, 70, 70, 70, 70, 70, 70,  0,  0,  0,  0
  609.   DATA    0, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60,  0,  0,  0,  0
  610.   DATA   50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50,  0,  0,  0,  0
  611.   DATA    0,  0,  0,  0, 40, 40, 40, 40,  0,  0,  0,  0,  0,  0,  0,  0,  0
  612.   DATA    0,  0,  0,  0, 30, 30, 30,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0
  613.   DATA    0,  0,  0,  0, 20, 20,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0
  614.   DATA    0,  0,  0,  0, 10,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0
  615.   '
  616.   ' Bewertung durch Zentrierung
  617.   DATA   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,20, 0, 0, 0, 0
  618.   DATA   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,19,19, 0, 0, 0, 0
  619.   DATA   0, 0, 0, 0, 0, 0, 0, 0, 0, 0,18,20,18, 0, 0, 0, 0
  620.   DATA   0, 0, 0, 0, 0, 0, 0, 0, 0,17,19,19,17, 0, 0, 0, 0
  621.   DATA   0, 0, 0, 0, 8,10,12,14,16,18,20,18,16,14,12,10, 8
  622.   DATA   0, 0, 0, 0, 9,11,13,15,17,19,19,17,15,13,11, 9, 0
  623.   DATA   0, 0, 0, 0,10,12,14,16,18,20,18,16,14,12,10, 0, 0
  624.   DATA   0, 0, 0, 0,11,13,15,17,19,19,17,15,13,11, 0, 0, 0
  625.   DATA   0, 0, 0, 0,12,14,16,18,20,18,16,14,12, 0, 0, 0, 0
  626.   DATA   0, 0, 0,11,13,15,17,19,19,17,15,13,11, 0, 0, 0, 0
  627.   DATA   0, 0,10,12,14,16,18,20,18,16,14,12,10, 0, 0, 0, 0
  628.   DATA   0, 9,11,13,15,17,19,19,17,15,13,11, 9, 0, 0, 0, 0
  629.   DATA   8,10,12,14,16,18,20,18,16,14,12,10, 8, 0, 0, 0, 0
  630.   DATA   0, 0, 0, 0,17,19,19,17, 0, 0, 0, 0, 0, 0, 0, 0, 0
  631.   DATA   0, 0, 0, 0,18,20,18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
  632.   DATA   0, 0, 0, 0,19,19, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
  633.   DATA   0, 0, 0, 0,20, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
  634.   '
  635.   ' Bewertung zum Vorwärtskommen
  636.   DATA   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,37, 0, 0, 0, 0
  637.   DATA   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,37,37, 0, 0, 0, 0
  638.   DATA   0, 0, 0, 0, 0, 0, 0, 0, 0, 0,37,37,37, 0, 0, 0, 0
  639.   DATA   0, 0, 0, 0, 0, 0, 0, 0, 0,37,36,36,37, 0, 0, 0, 0
  640.   DATA   0, 0, 0, 0,30,30,30,30,37,34,31,34,37,30,30,30,30
  641.   DATA   0, 0, 0, 0,30,30,30,30,30,30,30,30,30,30,30,30, 0
  642.   DATA   0, 0, 0, 0,30,30,30,30,30,30,30,30,30,30,30, 0, 0
  643.   DATA   0, 0, 0, 0,30,30,30,30,30,30,30,30,30,30, 0, 0, 0
  644.   DATA   0, 0, 0, 0,30,30,30,30,30,30,30,30,30, 0, 0, 0, 0
  645.   DATA   0, 0, 0,30,30,30,30,30,30,30,30,30,30, 0, 0, 0, 0
  646.   DATA   0, 0,30,30,30,30,30,30,30,30,30,30,30, 0, 0, 0, 0
  647.   DATA   0,30,30,30,30,30,30,30,30,30,30,30,30, 0, 0, 0, 0
  648.   DATA  30,30,30,30,30,30,30,30,30,30,30,30,30, 0, 0, 0, 0
  649.   DATA   0, 0, 0, 0,27,27,27,27, 0, 0, 0, 0, 0, 0, 0, 0, 0
  650.   DATA   0, 0, 0, 0,23,23,23, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
  651.   DATA   0, 0, 0, 0,17,17, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
  652.   DATA   0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
  653. RETURN
  654. '
  655. '
  656. '
  657. '
  658. > PROCEDURE haupt2
  659.   ~EVNT_MESAG(0)
  660.   fenster
  661. RETURN
  662. > PROCEDURE window_install
  663.   hand&=-1
  664.   wx&=0
  665.   wy&=19
  666.   ww&=380
  667.   wh&=380
  668.   line_anz&=(wh&-38)/16
  669.   x_aufl&=WORK_OUT(0)
  670.   y_aufl&=WORK_OUT(1)
  671.   text&=0
  672.   lines&=50
  673.   DIM t$(lines&)
  674. RETURN
  675. > FUNCTION openw
  676.   hand&=WIND_CREATE(&X1011,wx&,wy&,x_aufl&,y_aufl&)
  677.   '   vslide,Pf-up,down,Size,,move,full,close,name
  678.   name$=" Halma "+CHR$(0) !titelw
  679.   ~WIND_SET(hand&,2,CARD(SWAP(V:name$)),CARD(V:name$),0,0) !Titel
  680.   IF WIND_OPEN(hand&,wx&,wy&,ww&,wh&)=0
  681.     OUT 2,7
  682.     ~WIND_DELETE(hand&)
  683.     hand&=-1
  684.   ENDIF
  685.   RETURN hand&
  686. ENDFUNC
  687. > PROCEDURE closew(VAR hand&)
  688.   LOCAL f|
  689.   IF hand&>-1
  690.     ALERT 1,"Wirklich beenden?",1,"Ja|Nein",f|
  691.     IF f|=1
  692.       ~WIND_GET(hand&,5,wx&,wy&,ww&,wh&)
  693.       IF ww&>0 AND wh&>0
  694.         ~WIND_CLOSE(hand&)
  695.         ~WIND_DELETE(hand&)
  696.         IF prg!
  697.           END
  698.         ENDIF
  699.       ENDIF
  700.       hand&=-1
  701.     ENDIF
  702.   ENDIF
  703. RETURN
  704. > PROCEDURE fenster
  705.   LOCAL wx1&,wy1&,ww1&,wh1&
  706.   IF MENU(1)=40
  707.     IF hand&=-1
  708.       hand&=@openw
  709.     ELSE
  710.       ~WIND_SET(hand&,10,0,0,0,0) !TOPW
  711.     ENDIF
  712.   ENDIF
  713.   ' IF hand&=MENU(4), außer bei 41
  714.   SELECT MENU(1)
  715.   CASE 20               !REDRAW
  716.     DEFMOUSE 2
  717.     ~WIND_GET(hand&,11,wx1&,wy1&,ww1&,wh1&)
  718.     REPEAT
  719.       IF RC_INTERSECT(MENU(5),MENU(6),MENU(7),MENU(8),wx1&,wy1&,ww1&,wh1&)
  720.         CLIP wx1&,wy1&,ww1&,wh1&
  721.         redraw
  722.       ENDIF
  723.       ~WIND_GET(hand&,12,wx1&,wy1&,ww1&,wh1&)
  724.     UNTIL ww1&=0 OR wh1&=0
  725.     DEFMOUSE 0
  726.     CLIP wx&+1,wy&+19,ww&-1,wh&-20
  727.   CASE 21,29            !TOPW
  728.     ~WIND_SET(hand&,10,0,0,0,0)
  729.   CASE 22,41            !CLOSEW
  730.     @closew(hand&)
  731.   CASE 28               !MOVEW
  732.     wx&=MENU(5) AND &H1       !in 4er Schritten
  733.     wy&=(MENU(6) AND &H1)+3
  734.     ~WIND_SET(hand&,5,wx&,wy&,ww&,wh&)
  735.     CLIP wx&+1,wy&+19,ww&-1,wh&-20
  736.   ENDSELECT
  737. RETURN
  738. > PROCEDURE redraw
  739.   LOCAL i&
  740.   DEFFILL 0,0,0
  741.   PBOX wx&,wy&+19,wx&+ww&,wy&+wh&
  742.   zeige_feld
  743.   FOR i&=v_s& TO MIN(v_s&+line_anz&,lines&)
  744.     TEXT wx&,wy&+(i&-v_s&)*16+16,t$(i&)
  745.   NEXT i&
  746. RETURN
  747. '
  748. > PROCEDURE cls
  749.   LOCAL i&
  750.   DEFFILL 0,0,0
  751.   PBOX wx&,wy&+19,wx&+ww&-19,wy&+wh&-19
  752.   FOR i&=0 TO lines&
  753.     t$(i&)=""
  754.   NEXT i&
  755.   text&=0
  756. RETURN
  757. > PROCEDURE print(t$)
  758.   LOCAL i&,fertig!
  759.   REPEAT
  760.     fertig!=TRUE
  761.     INC text&
  762.     IF text&>lines&
  763.       text&=lines&
  764.       FOR i&=2 TO lines&
  765.         SWAP t$(i&-1),t$(i&)
  766.       NEXT i&
  767.     ENDIF
  768.     t$(text&)=LEFT$(t$,76)
  769.     IF LEN(t$)>76
  770.       t$=RIGHT$(t$,LEN(t$)-76)
  771.       fertig!=FALSE
  772.     ENDIF
  773.     IF v_s&+line_anz&<text&
  774.       v_s&=MAX(text&-line_anz&,0)
  775.       redraw
  776.     ELSE
  777.       TEXT wx&,wy&+text&*16+16,t$(text&)
  778.     ENDIF
  779.   UNTIL fertig!
  780. RETURN
  781. > FUNCTION key
  782.   LOCAL rueck&
  783.   REPEAT
  784.     rueck&=EVNT_MULTI(&X10001,0,0,0,0,0,0,0,0,0,0,0,0,0,a&,0,d&,d&,d&,d&,taste&,d&)
  785.     IF rueck& AND 10000
  786.       fenster
  787.     ENDIF
  788.   UNTIL rueck& AND 1
  789.   RETURN taste&
  790. ENDFUNC
  791. > FUNCTION maus(VAR mx&,my&)
  792.   LOCAL rueck&,d&
  793.   ' Fenster,Maus,Tastatur
  794.   ~EVNT_BUTTON(1,3,0)           !keine linke Taste
  795.   REPEAT
  796.     rueck&=EVNT_MULTI(&X110000,1,3,1,0,0,0,0,0,0,0,0,0,0,0,10,mx&,my&,mt&,d&,d&,d&)
  797.     mt&=GINTOUT(3)
  798.     control
  799.     IF rueck& AND 10000
  800.       fenster
  801.     ENDIF
  802.   UNTIL mt&>0
  803.   RETURN mt&
  804. ENDFUNC
  805. > FUNCTION input$(t$,len&)
  806.   LOCAL rueck&,ret$,asc|,scan|
  807.   print(t$+"_")
  808.   REPEAT
  809.     rueck&=EVNT_MULTI(&X10001,0,0,0,0,0,0,0,0,0,0,0,0,0,a&,0,d&,d&,d&,d&,taste&,d&)
  810.     '                                                   ^adr.buf(MENU())
  811.     IF rueck& AND 1             !tastatur
  812.       asc|=taste& AND 255
  813.       scan|=(taste& DIV 256) AND 255
  814.       SELECT asc|
  815.       CASE 8
  816.         IF LEN(ret$)
  817.           ret$=LEFT$(ret$,LEN(ret$)-1)
  818.         ENDIF
  819.       CASE 32 TO 255
  820.         IF LEN(ret$)<len&
  821.           ret$=ret$+CHR$(asc|)
  822.         ENDIF
  823.       ENDSELECT
  824.       DEC text&
  825.       print(t$+ret$+"_ ")
  826.     ENDIF
  827.     IF rueck& AND &X10000
  828.       fenster
  829.     ENDIF
  830.   UNTIL asc|=13
  831.   RETURN ret$
  832. ENDFUNC
  833. > PROCEDURE err
  834.   t%=TIMER
  835.   REPEAT
  836.     OUT 2,7
  837.   UNTIL TIMER-t%>40
  838.   PRINT ERR
  839.   IF prg!
  840.     END
  841.   ELSE
  842.     DO
  843.       ON MENU 100
  844.     LOOP
  845.   ENDIF
  846. RETURN
  847. '
  848. '
  849. ' 16                                        .                   ~
  850. ' 15                                     .  .                   ~
  851. ' 14                                  .  .  .                   ~
  852. ' 13                               .  .  .  .                   ~
  853. ' 12                .  .  .  .  .  .  .  .  .  .  .  .  .       ~
  854. ' 11                .  .  .  .  .  .  .  .  .  .  .  .          ~
  855. ' 10                .  .  .  .  .  .  .  .  .  .  .             ~
  856. '  9                .  .  .  .  .  .  .  .  .  .                ~
  857. '  8                .  .  .  .  .  .  .  .  .                   ~
  858. '  7             .  .  .  .  .  .  .  .  .  .                   ~
  859. '  6          .  .  .  .  .  .  .  .  .  .  .                   ~
  860. '  5       .  .  .  .  .  .  .  .  .  .  .  .                   ~
  861. '  4    .  .  .  .  .  .  .  .  .  .  .  .  .                   ~
  862. '  3                .  .  .  .                                  ~
  863. '  2                .  .  .                                     ~
  864. '  1                .  .                                        ~
  865. '  0                .                                           ~
  866. '      +                                                        ~
  867. '       0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16
  868.